Read csv files and calculate some statistics for the metrics
resultfile <- list.files(odir, pattern = "-results.csv", full.names = TRUE)
nonlargeresult <- grep("Wood", resultfile, invert = TRUE, value=TRUE)
lf <- lapply(nonlargeresult, csv::as.csv)
names(lf) <- names(NNdatasets)
#lf <- lf[c(1:4,6,7,10,12)]
gfr <- lapply(lf, function(dfr) cbind(
ds = str_remove(str_extract(dfr$event, "\\w+_"), "_"),
pfa = str_sub(str_remove(dfr$event, str_extract(dfr$event, "\\w+_")), 1, -4),
run = str_sub(dfr$event, -2, -1),
dfr[,c("RMSE","MAE","WAE","time")]
))
yfr <- lapply(gfr, function(dfr) {
as.data.frame(dfr %>%
group_by(pfa) %>%
summarise(time.mean = mean(time),
RMSE.min = min(RMSE),
RMSE.med = median(RMSE),
RMSE.d51 = median(RMSE) - min(RMSE),
MAE.med = median(MAE),
WAE.med = median(WAE)
)
)})
## `summarise()` ungrouping output (override with `.groups` argument)
## `summarise()` ungrouping output (override with `.groups` argument)
## `summarise()` ungrouping output (override with `.groups` argument)
## `summarise()` ungrouping output (override with `.groups` argument)
## `summarise()` ungrouping output (override with `.groups` argument)
## `summarise()` ungrouping output (override with `.groups` argument)
## `summarise()` ungrouping output (override with `.groups` argument)
## `summarise()` ungrouping output (override with `.groups` argument)
## `summarise()` ungrouping output (override with `.groups` argument)
## `summarise()` ungrouping output (override with `.groups` argument)
## `summarise()` ungrouping output (override with `.groups` argument)
## `summarise()` ungrouping output (override with `.groups` argument)
yfr <- lapply(yfr, function(dfr) transform(dfr, npfa = 1:nrow(dfr)))
Global scores on combined datasets (final table)
sfr.time <- sfrwide[, c(grep("time.rank", colnames(sfrwide)))]
time.score <- rank(apply(sfr.time, 1, sum), ties.method = "min")
sfr.RMSE <- sfrwide[, c(grep("RMSE.rank", colnames(sfrwide)))]
RMSE.score <- rank(apply(sfr.RMSE, 1, sum), ties.method = "min")
sfr.RMSEmed <- sfrwide[, c(grep("RMSEmed.rank", colnames(sfrwide)))]
RMSEmed.score <- rank(apply(sfr.RMSEmed, 1, sum), ties.method = "min")
sfr.RMSEd51 <- sfrwide[, c(grep("RMSEd51.rank", colnames(sfrwide)))]
RMSEd51.score <- rank(apply(sfr.RMSEd51, 1, sum), ties.method = "min")
sfr.MAE <- sfrwide[, c(grep("MAE.rank", colnames(sfrwide)))]
MAE.score <- rank(apply(sfr.MAE, 1, sum), ties.method = "min")
sfr.WAE <- sfrwide[, c(grep("WAE.rank", colnames(sfrwide)))]
WAE.score <- rank(apply(sfr.WAE, 1, sum), ties.method = "min")
scoredfr0 <- data.frame(sfr$mDette[,"pfa",drop=FALSE],
# scoredfr0 <- data.frame(sfr$uNeuroOne[,c("pfa")],
time.score,
RMSE.score,
RMSEmed.score,
RMSEd51.score,
MAE.score,
WAE.score)
scoredfr <- scoredfr0[order(scoredfr0$RMSE.score),]
rownames(scoredfr) <- NULL
kable(scoredfr)%>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
|
pfa
|
time.score
|
RMSE.score
|
RMSEmed.score
|
RMSEd51.score
|
MAE.score
|
WAE.score
|
|
nlsr::nlxb_none
|
20
|
1
|
2
|
10
|
2
|
4
|
|
rminer::fit_none
|
14
|
2
|
1
|
6
|
1
|
1
|
|
nnet::nnet_none
|
3
|
3
|
2
|
17
|
4
|
5
|
|
MachineShop::fit_none
|
6
|
4
|
8
|
20
|
8
|
8
|
|
validann::ann_BFGS
|
36
|
5
|
4
|
9
|
3
|
3
|
|
traineR::train.nnet_none
|
4
|
6
|
5
|
14
|
5
|
2
|
|
radiant.model::nn_none
|
10
|
7
|
10
|
32
|
12
|
11
|
|
validann::ann_CG
|
60
|
8
|
6
|
13
|
6
|
7
|
|
CaDENCE::cadence.fit_optim
|
46
|
9
|
26
|
48
|
19
|
32
|
|
brnn::brnn_Gauss-Newton
|
7
|
10
|
14
|
10
|
16
|
14
|
|
caret::avNNet_none
|
16
|
11
|
9
|
21
|
9
|
9
|
|
h2o::h2o.deeplearning_first-order
|
49
|
12
|
7
|
7
|
7
|
6
|
|
validann::ann_L-BFGS-B
|
37
|
13
|
13
|
35
|
15
|
13
|
|
EnsembleBase::Regression.Batch.Fit_none
|
5
|
14
|
15
|
28
|
14
|
15
|
|
monmlp::monmlp.fit_BFGS
|
26
|
15
|
11
|
19
|
10
|
12
|
|
qrnn::qrnn.fit_none
|
27
|
16
|
18
|
25
|
11
|
31
|
|
automl::automl_train_manual_trainwgrad_adam
|
48
|
17
|
19
|
34
|
17
|
18
|
|
minpack.lm::nlsLM_none
|
14
|
17
|
12
|
5
|
13
|
10
|
|
RSNNS::mlp_Rprop
|
24
|
19
|
28
|
52
|
26
|
30
|
|
deepnet::nn.train_BP
|
22
|
20
|
17
|
36
|
20
|
17
|
|
RSNNS::mlp_SCG
|
31
|
21
|
20
|
27
|
21
|
22
|
|
neuralnet::neuralnet_rprop-
|
19
|
22
|
22
|
45
|
23
|
23
|
|
keras::fit_adamax
|
50
|
23
|
16
|
23
|
17
|
16
|
|
neuralnet::neuralnet_rprop+
|
18
|
24
|
23
|
47
|
24
|
25
|
|
RSNNS::mlp_Std_Backpropagation
|
23
|
25
|
24
|
23
|
25
|
26
|
|
RSNNS::mlp_BackpropChunk
|
27
|
26
|
31
|
37
|
30
|
28
|
|
automl::automl_train_manual_trainwgrad_RMSprop
|
47
|
27
|
30
|
44
|
32
|
29
|
|
RSNNS::mlp_BackpropWeightDecay
|
29
|
28
|
21
|
31
|
22
|
19
|
|
neuralnet::neuralnet_sag
|
40
|
29
|
46
|
59
|
45
|
50
|
|
RSNNS::mlp_BackpropMomentum
|
25
|
30
|
24
|
26
|
26
|
21
|
|
keras::fit_adam
|
43
|
31
|
27
|
42
|
28
|
20
|
|
neuralnet::neuralnet_slr
|
30
|
32
|
35
|
39
|
36
|
41
|
|
ANN2::neuralnetwork_rmsprop
|
13
|
33
|
29
|
33
|
30
|
24
|
|
AMORE::train_ADAPTgdwm
|
16
|
34
|
33
|
40
|
29
|
36
|
|
ANN2::neuralnetwork_adam
|
12
|
35
|
32
|
30
|
33
|
27
|
|
keras::fit_nadam
|
44
|
36
|
37
|
55
|
38
|
41
|
|
keras::fit_adagrad
|
58
|
37
|
43
|
51
|
42
|
38
|
|
AMORE::train_ADAPTgd
|
9
|
38
|
34
|
12
|
35
|
33
|
|
automl::automl_train_manual_trainwpso
|
57
|
39
|
42
|
49
|
41
|
40
|
|
keras::fit_adadelta
|
59
|
40
|
36
|
18
|
34
|
34
|
|
validann::ann_Nelder-Mead
|
56
|
41
|
43
|
46
|
44
|
43
|
|
AMORE::train_BATCHgd
|
39
|
42
|
40
|
28
|
43
|
35
|
|
AMORE::train_BATCHgdwm
|
41
|
43
|
37
|
15
|
40
|
37
|
|
keras::fit_sgd
|
51
|
44
|
47
|
43
|
48
|
46
|
|
ANN2::neuralnetwork_sgd
|
10
|
45
|
40
|
22
|
39
|
39
|
|
deepdive::deepnet_adam
|
33
|
46
|
39
|
1
|
37
|
44
|
|
neuralnet::neuralnet_backprop
|
35
|
47
|
45
|
16
|
45
|
45
|
|
monmlp::monmlp.fit_Nelder-Mead
|
32
|
48
|
49
|
50
|
47
|
47
|
|
keras::fit_rmsprop
|
38
|
49
|
54
|
58
|
54
|
54
|
|
CaDENCE::cadence.fit_Rprop
|
55
|
50
|
55
|
60
|
52
|
56
|
|
deepdive::deepnet_rmsProp
|
34
|
51
|
48
|
4
|
49
|
48
|
|
RSNNS::mlp_BackpropBatch
|
42
|
52
|
51
|
41
|
51
|
51
|
|
snnR::snnR_none
|
8
|
53
|
50
|
8
|
50
|
49
|
|
validann::ann_SANN
|
21
|
54
|
52
|
53
|
53
|
53
|
|
CaDENCE::cadence.fit_psoptim
|
53
|
55
|
56
|
53
|
56
|
57
|
|
deepdive::deepnet_momentum
|
54
|
56
|
53
|
3
|
55
|
52
|
|
RSNNS::mlp_Quickprop
|
44
|
57
|
58
|
38
|
57
|
58
|
|
elmNNRcpp::elm_train_extremeML
|
1
|
58
|
59
|
57
|
59
|
59
|
|
deepdive::deepnet_gradientDescent
|
52
|
59
|
57
|
2
|
58
|
55
|
|
ELMR::OSelm_train.formula_extremeML
|
2
|
60
|
60
|
56
|
60
|
60
|
Figures
Some plots
plot(scoredfr[,c("time.score", "RMSE.score", "RMSEmed.score", "RMSEd51.score")], las = 1)
op <- par(mfrow = c(1,3), las = 1, mar = c(0,0.5,0,0.5), oma = c(2,2,3.5,2), cex = 1.1)
plot(scoredfr[,c("RMSE.score", "RMSEmed.score")]); abline(v=10.5, lty = 2)
mtext("x=RMSE.score, y=RMSEmed.score", line = 1.5, font = 2)
plot(scoredfr[,c("RMSE.score", "time.score")], yaxt = "n"); abline(v=10.5, lty = 2)
mtext("x=RMSE.score, y=time.score", line = 1.5, font = 2)
plot(scoredfr[,c("RMSE.score", "RMSEd51.score")], yaxt = "n"); Axis(scoredfr[,5], side = 4)
mtext("x=RMSE.score, y=RMSEd51.score", line = 1.5, font = 2)
# mtext("(x=RMSE.score, y=RMSEmed.score) (x=RMSE.score, y=time.score) (x=RMSE.score, y=RMSEd51.score)",
# outer = TRUE, line = 2, font = 2)
par(op)
Comparison of global scores and RMSE value per dataset
## =====================================
## GLOBAL SCORE APPLIED TO EVERY DATASET
## =====================================
merge_sfr_dfr <- function(x, y) {
z <- cbind(
x[,c("npfa","pfa","time.mean","RMSE.min","time.rank","RMSE.rank")],
y[,c("time.score","RMSE.score")]
)
z[order(z$RMSE.score),]
}
zfr <- lapply(sfr, merge_sfr_dfr, y = scoredfr0)
#str(zfr)
#str(sfr)
## =========================
## GRAPHIC RMSEscore_RMSEmin
## =========================
op <- par(mfrow = c(length(yfr)/2,2), las = 1, mar = c(0,4,0,0), oma = c(1,1,3,1))
for (j in seq_along(zfr)) {
names(zfr)[j]
plot(log1p(zfr[[j]][, "RMSE.score"]), log1p(zfr[[j]][, "RMSE.min"]),
xlab = "RMSE.score (log1p)", ylab = "RMSE.min (log1p)", # main = names(zfr)[j],
las = 1, col = 0, xaxt = "n")
mtext(names(zfr)[j], line = -1.2, cex = 0.8)
text(log1p(zfr[[j]][, "RMSE.score"]), log1p(zfr[[j]][, "RMSE.min"]),
labels = zfr[[j]][, "RMSE.score"])
}
mtext("x=log1p(RMSE.score) (global) y=log1p(RMSE.min) (per dataset)", outer = TRUE, line = 1)
op <- par(mfrow = c(length(yfr)/2,2), las = 1, mar = c(0,4,0,0), oma = c(1,1,3,1))
for (j in seq_along(zfr)) {
names(zfr)[j]
plot(zfr[[j]][, "RMSE.score"], zfr[[j]][, "RMSE.min"],
xlab = "RMSE.score", ylab = "RMSE.min", # main = names(zfr)[j],
las = 1, col=0, xaxt = "n", pch=as.character(zfr[[j]][, "RMSE.score"]))
mtext(names(zfr)[j], line = -1.2, cex = 0.8)
text(zfr[[j]][, "RMSE.score"], zfr[[j]][, "RMSE.min"],
labels = zfr[[j]][, "RMSE.score"])
}
mtext("x=RMSE.score (global) y=RMSE.min (per dataset)", outer = TRUE, line = 1)
Comparison of global scores and time mean per dataset
## ==============================
## GRAPHIC RMSEscore_timemean
## ==============================
op <- par(mfrow = c(length(yfr)/2,2), las = 1, mar = c(0,0,0,0), oma = c(1,1,3,1))
for (j in seq_along(zfr)) {
names(zfr)[j]
plot(log1p(zfr[[j]][, "RMSE.score"]), log1p(zfr[[j]][, "time.mean"]),
xlab = "RMSE.score (log1p)", ylab = "time.mean (log1p)",
las = 1, col = 0, xaxt = "n", yaxt = "n")
mtext(names(zfr)[j], line = -1.2, cex = 0.8)
text(log1p(zfr[[j]][, "RMSE.score"]), log1p(zfr[[j]][, "time.mean"]),
labels = zfr[[j]][, "RMSE.score"])
}
mtext("x=log1p(RMSE.score) (global) y=log1p(time.mean) (per dataset)", outer = TRUE, line = 1)
op <- par(mfrow = c(length(yfr)/2,2), las = 1, mar = c(0,4,0,0), oma = c(1,1,3,1))
for (j in seq_along(zfr)) {
names(zfr)[j]
plot(zfr[[j]][, "RMSE.score"], zfr[[j]][, "time.mean"],
xlab = "RMSE.score", ylab = "time.mean",
las = 1, col = 0, xaxt = "n")
mtext(names(zfr)[j], line = -1.2, cex = 0.8)
text(zfr[[j]][, "RMSE.score"], zfr[[j]][, "time.mean"],
labels = zfr[[j]][, "RMSE.score"])
}
mtext("x=RMSE.score (global) y=time.mean (per dataset)", outer = TRUE, line = 1)
By different number of algorithms
## =======================================
## GRAPHIC RMSEmin_timemean - 49 algos
## =======================================
op <- par(mfrow = c(length(yfr)/2,2), las = 1, mar = c(0,0,0,0), oma = c(1,1,3,1))
for (j in seq_along(zfr)) {
names(zfr)[j]
plot(log1p(zfr[[j]][, "RMSE.min"]), log1p(zfr[[j]][, "time.mean"]),
xlab = "RMSE.min", ylab = "time.mean", #Â main = names(zfr)[j],
las = 1, col = 0, xaxt = "n", yaxt = "n")
mtext(names(zfr)[j], line = -1.2, cex = 0.8)
text(log1p(zfr[[j]][, "RMSE.min"]), log1p(zfr[[j]][, "time.mean"]),
labels = zfr[[j]][, "RMSE.score"])
}
mtext("x=RMSE.min (per dataset) y=time.mean (per dataset) 49 algos", outer = TRUE, line = 1)
## =======================================
## GRAPHIC RMSEmin_timemean - 12 algos
## =======================================
op <- par(mfrow = c(length(yfr)/2,2), las = 1, mar = c(0,0,0,0), oma = c(1,1,3,1))
for (j in seq_along(zfr)) {
names(zfr)[j]
plot(log1p(zfr[[j]][1:12, "RMSE.min"]), log1p(zfr[[j]][1:12, "time.mean"]),
xlab = "RMSE.min", ylab = "time.mean", #Â main = names(zfr)[j],
las = 1, col = 0, xaxt = "n", yaxt = "n")
mtext(names(zfr)[j], line = -1.2, cex = 0.8)
text(log1p(zfr[[j]][1:12, "RMSE.min"]), log1p(zfr[[j]][1:12, "time.mean"]),
labels = zfr[[j]][1:12, "RMSE.score"])
}
mtext("x=RMSE.min (per dataset) y=time.mean (per dataset) 12 algos", outer = TRUE, line = 1)
## =======================================
## GRAPHIC RMSEmin_timemean - 09 algos
## =======================================
op <- par(mfrow = c(length(yfr)/2,2), las = 1, mar = c(0,0,0,0), oma = c(1,1,3,1))
for (j in seq_along(zfr)) {
names(zfr)[j]
plot(log1p(zfr[[j]][1:9, "RMSE.min"]), log1p(zfr[[j]][1:9, "time.mean"]),
xlab = "RMSE.min", ylab = "time.mean", #Â main = names(zfr)[j],
las = 1, col = 0, xaxt = "n", yaxt = "n")
mtext(names(zfr)[j], line = -1.2, cex = 0.8)
text(log1p(zfr[[j]][1:9, "RMSE.min"]), log1p(zfr[[j]][1:9, "time.mean"]),
labels = zfr[[j]][1:9, "RMSE.score"])
}
mtext("x=RMSE.min (per dataset) y=time.mean (per dataset) 9 algos", outer = TRUE, line = 1)
## THE END
## THE END
Final graphics for article
myscore <- c(rep(2, 10), rep(1, NROW(zfr[[1]])-10))
myds <- seq_along(zfr)[names(zfr) %in% c("mIshigami", "uDreyfus1")]
png("mIshigami-uDreyfus1-RMSEmin.png", width = 1000, height = 500)
op <- par(mfrow = c(1,2), las = 1, mar = c(0,3,0,0), oma = c(1,1,3,2))
for (j in myds) {
plot(cumsum(myscore), zfr[[j]][, "RMSE.min"],
xlab = "RMSE.score", ylab = "RMSE.min",
ylim=c(.9*min(zfr[[j]][, "RMSE.min"]), 1.1*max(zfr[[j]][, "RMSE.min"])),
las = 1, col=0, xaxt = "n", pch=as.character(zfr[[j]][, "RMSE.score"]))
mtext(names(zfr)[j], line = -1.2, cex = 1.2)
text(cumsum(myscore), zfr[[j]][, "RMSE.min"],
labels = zfr[[j]][, "RMSE.score"])
grid()
}
mtext("RMSE.min (per dataset) against RMSE.score (global)", outer = TRUE, line = 1)
dev.off()
## quartz_off_screen
## 2
myscore <- c(rep(2, 10), rep(1, NROW(zfr[[1]])-30), rep(2, 20))
#myscore <- rep(2, NROW(zfr[[1]]))
png("mIshigami-uDreyfus1-timmean.png", width = 1000, height = 500)
op <- par(mfrow = c(1,2), las = 1, mar = c(0,3,0,0), oma = c(1,1,3,2))
for (j in myds) {
#myscore <- rep(1, NROW(zfr[[j]]))
#myscore[zfr[[j]][, "time.mean"] <= 0.5] <- 3
plot(cumsum(myscore), zfr[[j]][, "time.mean"],
xlab = "RMSE.score", ylab = "time.mean",
ylim=c(.9*min(zfr[[j]][, "time.mean"]), 1.1*max(zfr[[j]][, "time.mean"])),
las = 1, col=0, xaxt = "n", pch=as.character(zfr[[j]][, "RMSE.score"]))
mtext(names(zfr)[j], line = -1.2, cex = 1.2)
text(cumsum(myscore), zfr[[j]][, "time.mean"],
labels = zfr[[j]][, "RMSE.score"])
grid()
}
mtext("time.mean (per dataset) against RMSE.score (global)", outer = TRUE, line = 1)
dev.off()
## quartz_off_screen
## 2